As stated in the assignment, you should have worked through the script that demonstrates how you can call Radiant’s decision analysis tools directly, edit parameters, re-compute a tree, and extract the relevant values. Feel free to copy some of that code in here if helpful.
REMINDER: Make sure any files you refer to have LOCAL links and the files are pushed to the repo. This must compile on the TA computers.
library(radiant)## Loading required package: radiant.data## Loading required package: magrittr## Loading required package: ggplot2## Loading required package: lubridate##
## Attaching package: 'lubridate'## The following object is masked from 'package:base':
##
## date## Loading required package: tidyr##
## Attaching package: 'tidyr'## The following object is masked from 'package:magrittr':
##
## extract## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following objects are masked from 'package:lubridate':
##
## intersect, setdiff, union## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union## Registered S3 method overwritten by 'radiant.data':
## method from
## print.gtable gtable##
## Attaching package: 'radiant.data'## The following objects are masked from 'package:lubridate':
##
## month, wday## The following object is masked from 'package:ggplot2':
##
## diamonds## Loading required package: radiant.design## Loading required package: mvtnorm## Loading required package: radiant.basics## Loading required package: radiant.model## Loading required package: radiant.multivariate## create tree
input_list <- yaml::yaml.load_file("san-carlos-input-vars-complete.yaml")
result <- dtree(input_list)
## summarize results
summary(result)## Decision tree input:
## name: San Carlos Mud Slides
## variables:
## P(MS): 0.01
## P(N): 1 - P(MS)
## P(B): 0.05
## P(NB): 1 - P(B)
## P(Pos|MS): 0.9
## P(Neg|MS): 1 - P(Pos|MS)
## P(Neg|N): 0.85
## P(Pos|N): 1 - P(Neg|N)
## wall cost: 40000
## slide payoff: -1000000
## P(Pos and MS): P(Pos|MS) * P(MS)
## P(Pos and N): P(Pos|N) * P(N)
## P(Neg and MS): P(Neg|MS) * P(MS)
## P(Neg and N): P(Neg|N) * P(N)
## P(Neg): P(Neg and MS) + P(Neg and N)
## P(Pos): P(Pos and MS) + P(Pos and N)
## P(MS|Pos): P(Pos and MS) / P(Pos)
## P(MS|Neg): P(Neg and MS) / P(Neg)
## P(N|Pos): P(Pos and N) / P(Pos)
## P(N|Neg): P(Neg and N) / P(Neg)
## type: decision
## Build Wall:
## cost: wall cost
## type: chance
## Mud Slide:
## p: P(MS)
## type: chance
## Wall Breaks:
## p: P(B)
## payoff: slide payoff
## Wall Stands:
## p: P(NB)
## payoff: 0
## Nothing:
## p: P(N)
## payoff: 0
## Do nothing:
## type: chance
## Mud Slide:
## p: P(MS)
## payoff: slide payoff
## Nothing:
## p: P(N)
## payoff: 0
## Test:
## type: chance
## Positive:
## p: P(Pos)
## type: decision
## Build Wall:
## cost: wall cost
## type: chance
## Mud Slide:
## p: P(MS|Pos)
## type: chance
## Wall Breaks:
## p: P(B)
## payoff: slide payoff
## Wall Stands:
## p: P(NB)
## payoff: 0
## Nothing:
## p: P(N|Pos)
## payoff: 0
## Do nothing:
## type: chance
## Mud Slide:
## p: P(MS|Pos)
## payoff: slide payoff
## Nothing:
## p: P(N|Pos)
## payoff: 0
## Negative:
## p: P(Neg)
## type: decision
## Build Wall:
## cost: wall cost
## type: chance
## Mud Slide:
## p: P(MS|Neg)
## type: chance
## Wall Breaks:
## p: P(B)
## payoff: slide payoff
## Wall Stands:
## p: P(NB)
## payoff: 0
## Nothing:
## p: P(N|Neg)
## payoff: 0
## Do nothing:
## type: chance
## Mud Slide:
## p: P(MS|Neg)
## payoff: slide payoff
## Nothing:
## p: P(N|Neg)
## payoff: 0## plot final tree
plot(result, final = TRUE)## 'result' is just a list of output
str(result)## List of 9
## $ jl_init :Classes 'Node', 'R6' <Node>
## Public:
## AddChild: function (name, check = c("check", "no-warn", "no-check"), ...)
## AddChildNode: function (child)
## AddSibling: function (name, check = c("check", "no-warn", "no-check"), ...)
## AddSiblingNode: function (sibling)
## averageBranchingFactor: active binding
## Build Wall: Node, R6
## children: active binding
## Climb: function (...)
## clone: function (deep = FALSE)
## count: active binding
## Do: function (fun, ..., traversal = c("pre-order", "post-order",
## Do nothing: Node, R6
## fields: active binding
## fieldsAll: active binding
## FindNode: function (name)
## Get: function (attribute, ..., traversal = c("pre-order", "post-order",
## height: active binding
## initialize: function (name, check = c("check", "no-warn", "no-check"), ...)
## isBinary: active binding
## isLeaf: active binding
## isRoot: active binding
## leafCount: active binding
## leaves: active binding
## level: active binding
## levelName: active binding
## name: active binding
## Navigate: function (path)
## parent: active binding
## path: active binding
## pathString: active binding
## position: active binding
## Prune: function (pruneFun)
## RemoveAttribute: function (name, stopIfNotAvailable = TRUE)
## RemoveChild: function (name)
## Revert: function (recursive = TRUE)
## root: active binding
## Set: function (..., traversal = c("pre-order", "post-order", "in-order",
## siblings: active binding
## Sort: function (attribute, ..., decreasing = FALSE, recursive = TRUE)
## Test: Node, R6
## totalCount: active binding
## type: decision
## Private:
## p_children: list
## p_name: San Carlos Mud Slides
## p_parent: NULL
## $ jl :Classes 'Node', 'R6' <Node>
## Public:
## AddChild: function (name, check = c("check", "no-warn", "no-check"), ...)
## AddChildNode: function (child)
## AddSibling: function (name, check = c("check", "no-warn", "no-check"), ...)
## AddSiblingNode: function (sibling)
## averageBranchingFactor: active binding
## Build Wall: Node, R6
## children: active binding
## Climb: function (...)
## clone: function (deep = FALSE)
## count: active binding
## decision: Test
## Do: function (fun, ..., traversal = c("pre-order", "post-order",
## Do nothing: Node, R6
## fields: active binding
## fieldsAll: active binding
## FindNode: function (name)
## Get: function (attribute, ..., traversal = c("pre-order", "post-order",
## height: active binding
## id: id1
## initialize: function (name, check = c("check", "no-warn", "no-check"), ...)
## isBinary: active binding
## isLeaf: active binding
## isRoot: active binding
## leafCount: active binding
## leaves: active binding
## level: active binding
## levelName: active binding
## name: active binding
## Navigate: function (path)
## parent: active binding
## path: active binding
## pathString: active binding
## payoff: -7750
## position: active binding
## Prune: function (pruneFun)
## RemoveAttribute: function (name, stopIfNotAvailable = TRUE)
## RemoveChild: function (name)
## Revert: function (recursive = TRUE)
## root: active binding
## Set: function (..., traversal = c("pre-order", "post-order", "in-order",
## siblings: active binding
## Sort: function (attribute, ..., decreasing = FALSE, recursive = TRUE)
## Test: Node, R6
## totalCount: active binding
## type: decision
## Private:
## p_children: list
## p_name: San Carlos Mud Slides
## p_parent: NULL
## $ yl :List of 6
## ..$ name : chr "San Carlos Mud Slides"
## ..$ variables :List of 20
## .. ..$ P(MS) : num 0.01
## .. ..$ P(N) : chr "1 - P(MS)"
## .. ..$ P(B) : num 0.05
## .. ..$ P(NB) : chr "1 - P(B)"
## .. ..$ P(Pos|MS) : num 0.9
## .. ..$ P(Neg|MS) : chr "1 - P(Pos|MS)"
## .. ..$ P(Neg|N) : num 0.85
## .. ..$ P(Pos|N) : chr "1 - P(Neg|N)"
## .. ..$ wall cost : int 40000
## .. ..$ slide payoff : int -1000000
## .. ..$ P(Pos and MS): chr "P(Pos|MS) * P(MS)"
## .. ..$ P(Pos and N) : chr "P(Pos|N) * P(N)"
## .. ..$ P(Neg and MS): chr "P(Neg|MS) * P(MS)"
## .. ..$ P(Neg and N) : chr "P(Neg|N) * P(N)"
## .. ..$ P(Neg) : chr "P(Neg and MS) + P(Neg and N)"
## .. ..$ P(Pos) : chr "P(Pos and MS) + P(Pos and N)"
## .. ..$ P(MS|Pos) : chr "P(Pos and MS) / P(Pos)"
## .. ..$ P(MS|Neg) : chr "P(Neg and MS) / P(Neg)"
## .. ..$ P(N|Pos) : chr "P(Pos and N) / P(Pos)"
## .. ..$ P(N|Neg) : chr "P(Neg and N) / P(Neg)"
## ..$ type : chr "decision"
## ..$ Build Wall:List of 4
## .. ..$ cost : chr "wall cost"
## .. ..$ type : chr "chance"
## .. ..$ Mud Slide:List of 4
## .. .. ..$ p : chr "P(MS)"
## .. .. ..$ type : chr "chance"
## .. .. ..$ Wall Breaks:List of 2
## .. .. .. ..$ p : chr "P(B)"
## .. .. .. ..$ payoff: chr "slide payoff"
## .. .. ..$ Wall Stands:List of 2
## .. .. .. ..$ p : chr "P(NB)"
## .. .. .. ..$ payoff: int 0
## .. ..$ Nothing :List of 2
## .. .. ..$ p : chr "P(N)"
## .. .. ..$ payoff: int 0
## ..$ Do nothing:List of 3
## .. ..$ type : chr "chance"
## .. ..$ Mud Slide:List of 2
## .. .. ..$ p : chr "P(MS)"
## .. .. ..$ payoff: chr "slide payoff"
## .. ..$ Nothing :List of 2
## .. .. ..$ p : chr "P(N)"
## .. .. ..$ payoff: int 0
## ..$ Test :List of 3
## .. ..$ type : chr "chance"
## .. ..$ Positive:List of 4
## .. .. ..$ p : chr "P(Pos)"
## .. .. ..$ type : chr "decision"
## .. .. ..$ Build Wall:List of 4
## .. .. .. ..$ cost : chr "wall cost"
## .. .. .. ..$ type : chr "chance"
## .. .. .. ..$ Mud Slide:List of 4
## .. .. .. .. ..$ p : chr "P(MS|Pos)"
## .. .. .. .. ..$ type : chr "chance"
## .. .. .. .. ..$ Wall Breaks:List of 2
## .. .. .. .. .. ..$ p : chr "P(B)"
## .. .. .. .. .. ..$ payoff: chr "slide payoff"
## .. .. .. .. ..$ Wall Stands:List of 2
## .. .. .. .. .. ..$ p : chr "P(NB)"
## .. .. .. .. .. ..$ payoff: int 0
## .. .. .. ..$ Nothing :List of 2
## .. .. .. .. ..$ p : chr "P(N|Pos)"
## .. .. .. .. ..$ payoff: int 0
## .. .. ..$ Do nothing:List of 3
## .. .. .. ..$ type : chr "chance"
## .. .. .. ..$ Mud Slide:List of 2
## .. .. .. .. ..$ p : chr "P(MS|Pos)"
## .. .. .. .. ..$ payoff: chr "slide payoff"
## .. .. .. ..$ Nothing :List of 2
## .. .. .. .. ..$ p : chr "P(N|Pos)"
## .. .. .. .. ..$ payoff: int 0
## .. ..$ Negative:List of 4
## .. .. ..$ p : chr "P(Neg)"
## .. .. ..$ type : chr "decision"
## .. .. ..$ Build Wall:List of 4
## .. .. .. ..$ cost : chr "wall cost"
## .. .. .. ..$ type : chr "chance"
## .. .. .. ..$ Mud Slide:List of 4
## .. .. .. .. ..$ p : chr "P(MS|Neg)"
## .. .. .. .. ..$ type : chr "chance"
## .. .. .. .. ..$ Wall Breaks:List of 2
## .. .. .. .. .. ..$ p : chr "P(B)"
## .. .. .. .. .. ..$ payoff: chr "slide payoff"
## .. .. .. .. ..$ Wall Stands:List of 2
## .. .. .. .. .. ..$ p : chr "P(NB)"
## .. .. .. .. .. ..$ payoff: int 0
## .. .. .. ..$ Nothing :List of 2
## .. .. .. .. ..$ p : chr "P(N|Neg)"
## .. .. .. .. ..$ payoff: int 0
## .. .. ..$ Do nothing:List of 3
## .. .. .. ..$ type : chr "chance"
## .. .. .. ..$ Mud Slide:List of 2
## .. .. .. .. ..$ p : chr "P(MS|Neg)"
## .. .. .. .. ..$ payoff: chr "slide payoff"
## .. .. .. ..$ Nothing :List of 2
## .. .. .. .. ..$ p : chr "P(N|Neg)"
## .. .. .. .. ..$ payoff: int 0
## $ vars : Named num [1:20] 0.01 0.99 0.05 0.95 0.9 0.1 0.85 0.15 40000 -1000000 ...
## ..- attr(*, "names")= chr [1:20] "P(MS)" "P(N)" "P(B)" "P(NB)" ...
## $ opt : chr "max"
## $ type_none : chr ""
## $ prob_check: chr ""
## $ cost_check: chr ""
## $ payoff : Named num [1:28] -7750 -40500 -50000 -1000000 0 0 -10000 -1000000 0 -7750 ...
## ..- attr(*, "names")= chr [1:28] "San Carlos Mud Slides" "Build Wall" "Mud Slide" "Wall Breaks" ...
## - attr(*, "class")= chr [1:2] "dtree" "list"## jl is the final decision tree we need to extract stuff from
result$jl## levelName
## 1 San Carlos Mud Slides
## 2 ¦--Build Wall
## 3 ¦ ¦--Mud Slide
## 4 ¦ ¦ ¦--Wall Breaks
## 5 ¦ ¦ °--Wall Stands
## 6 ¦ °--Nothing
## 7 ¦--Do nothing
## 8 ¦ ¦--Mud Slide
## 9 ¦ °--Nothing
## 10 °--Test
## 11 ¦--Positive
## 12 ¦ ¦--Build Wall
## 13 ¦ ¦ ¦--Mud Slide
## 14 ¦ ¦ ¦ ¦--Wall Breaks
## 15 ¦ ¦ ¦ °--Wall Stands
## 16 ¦ ¦ °--Nothing
## 17 ¦ °--Do nothing
## 18 ¦ ¦--Mud Slide
## 19 ¦ °--Nothing
## 20 °--Negative
## 21 ¦--Build Wall
## 22 ¦ ¦--Mud Slide
## 23 ¦ ¦ ¦--Wall Breaks
## 24 ¦ ¦ °--Wall Stands
## 25 ¦ °--Nothing
## 26 °--Do nothing
## 27 ¦--Mud Slide
## 28 °--Nothing## extract payoffs
result$jl$Get('payoff')## San Carlos Mud Slides Build Wall Mud Slide
## -7750.000 -40500.000 -50000.000
## Wall Breaks Wall Stands Nothing
## -1000000.000 0.000 0.000
## Do nothing Mud Slide Nothing
## -10000.000 -1000000.000 0.000
## Test Positive Build Wall
## -7750.000 -42857.143 -42857.143
## Mud Slide Wall Breaks Wall Stands
## -50000.000 -1000000.000 0.000
## Nothing Do nothing Mud Slide
## 0.000 -57142.857 -1000000.000
## Nothing Negative Build Wall
## 0.000 -1186.944 -40059.347
## Mud Slide Wall Breaks Wall Stands
## -50000.000 -1000000.000 0.000
## Nothing Do nothing Mud Slide
## 0.000 -1186.944 -1000000.000
## Nothing
## 0.000## manipulate input parameter and re-compute
wall_cost_range <- seq(0,150000, 5000)
slide_payoff_range <- seq(-3000000, 0, 100000)
combination <- expand_grid(x = wall_cost_range, y = slide_payoff_range)
x <- nrow(combination)
payoff1 <- c()
payoff2 <- c()
for (i in 1:x) {
input_list$variables[["slide payoff"]] <- combination[[2]][i]
input_list$variables[['wall cost']] <- combination[[1]][i]
result2 <- dtree(input_list)
payoff1[i] <- c(result2$jl$Get('payoff')[["Build Wall"]])
payoff2[i] <- c(result2$jl$Get('payoff')[["Do nothing"]])
}
library(tidyverse)## ── Attaching packages ─────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──## ✔ tibble 2.1.3 ✔ purrr 0.3.2
## ✔ readr 1.3.1 ✔ stringr 1.4.0
## ✔ tibble 2.1.3 ✔ forcats 0.4.0## ── Conflicts ────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ forcats::as_factor() masks radiant.data::as_factor()
## ✖ lubridate::as.difftime() masks base::as.difftime()
## ✖ lubridate::date() masks base::date()
## ✖ tidyr::extract() masks magrittr::extract()
## ✖ dplyr::filter() masks stats::filter()
## ✖ lubridate::intersect() masks base::intersect()
## ✖ purrr::is_double() masks radiant.data::is_double()
## ✖ purrr::is_empty() masks radiant.data::is_empty()
## ✖ purrr::is_numeric() masks radiant.data::is_numeric()
## ✖ dplyr::lag() masks stats::lag()
## ✖ radiant.data::month() masks lubridate::month()
## ✖ purrr::set_names() masks magrittr::set_names()
## ✖ lubridate::setdiff() masks base::setdiff()
## ✖ lubridate::union() masks base::union()
## ✖ radiant.data::wday() masks lubridate::wday()final_payoffs <- tibble(payoff1,payoff2)library(plotly)##
## Attaching package: 'plotly'## The following objects are masked from 'package:radiant.data':
##
## ggplotly, subplot## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutplot <- plot_ly(x = ~combination$y, y= ~combination$x, z= ~final_payoffs$payoff1, type= 'scatter3d', name ='Build Wall', mode = 'markers') %>%
add_trace(x= ~combination$y, y= ~combination$x, z= ~final_payoffs$payoff2, name = 'Do Nothing', mode = 'markers') %>%
layout(scene = list(xaxis = list(title = 'Slide Payoff'),
yaxis = list(title = 'Wall Cost'),
zaxis = list(title = 'Final Payoff')))
plotResults:
As the wall cost increased, the final payoff for building wall decreases but doesn’t change the payoff of doing nothing. If the Wall cost is less than $10000, building wall is the optimal strategy; otherwise, we should choose to do nothing.
As the slide payoff increased, the final payoff for both doing nothing and building wall increase while do nothing strategy is more sensitive to the change of slide payoff. No matter how large the slide payoff is, do nothing is always the better choice.
In conclusion, doing nothing is a better strategy.